home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagd_f.zip / EXEC.SWG / 0017_Yet Another Window Shell.pas < prev    next >
Pascal/Delphi Source File  |  1994-01-27  |  10KB  |  306 lines
  1. {
  2. -> I seen some code posted here a few weeks ago. I meant to save it,
  3. -> but didn't.  The code creates a windowed DOS shell.  I would like
  4. -> to simply run a .BAT installation file in a window from my pascal
  5. -> program.
  6.  
  7. Here's some code that I posted.  Maybe this is what you were talking
  8. about:
  9. }
  10.  
  11. (* Written by Tom Carroll, Nov 24, 1993.
  12.  
  13.    Adapted from the example code posted by Kelly Small in the FidoNet
  14.    Pascal echo 11/19/93.
  15.  
  16.    Released to the Public Domain 11/24/93.
  17.  
  18.    Please give credit where credit is due
  19.  
  20.    This unit will execute a program within a text window
  21.    and all program scrolling will be maintained within
  22.    the window.
  23.  
  24.    11-24-93 - Initial release /twc/
  25.    11-29-93 - Added code to allow for multiple border styles,
  26.               color usage, window titles, and screen save/restore
  27.               under the window. /twc/
  28.  
  29.    FUTURE PLANS:  To add a check for the video mode and adjust the
  30.                   window boundary checking accordingly.
  31. *)
  32.  
  33. UNIT ExecTWin;
  34.  
  35. INTERFACE
  36.  
  37. FUNCTION ExecWin(ProgName, Params, Title : STRING;
  38.                  LeftCol, TopLine, RightCol, BottomLine,
  39.                  ForeColor, BackColor, ForeBorder, BackBorder,
  40.                  Border, ForeTitle, BackTitle : WORD) : WORD;
  41.  
  42. IMPLEMENTATION
  43.  
  44. USES
  45.    Dos,
  46.    Crt,
  47.    ScrnCopy;
  48.  
  49. VAR
  50.    OldIntVect : POINTER;
  51.  
  52. {$F+}
  53. PROCEDURE Int29Handler(AX, BX, CX, DX, SI, DI, DS, ES, BP : WORD); INTERRUPT;
  54.  
  55. VAR
  56.    Dummy : BYTE;
  57.  
  58. BEGIN
  59.    Write(Chr(Lo(AX)));         {write each character to screen}
  60.    Asm Sti; END;
  61. END;
  62. {$F-}
  63.  
  64. PROCEDURE HookInt29;
  65.  
  66. BEGIN
  67.    GetIntVec($29, OldIntVect);               { Save the old vector }
  68.    SetIntVec($29, @Int29Handler);            { Install interrupt handler }
  69. END;
  70.  
  71. FUNCTION ExecWin(ProgName, Params, Title : STRING;
  72.                  LeftCol, TopLine, RightCol, BottomLine,
  73.                  ForeColor, BackColor, ForeBorder, BackBorder,
  74.                  Border, ForeTitle, BackTitle : WORD) : WORD;
  75.  
  76. {
  77.   ProgName   = Program name to execute (must includes the full path)
  78.   Params     = Program parameters passed to child process
  79.   Title      = Title assigned to the text window (unused if blank)
  80.   LeftCol    = Left column of the window border
  81.   TopLine    = Top line of the window border
  82.   RightCol   = Right column of the window border
  83.   BottomLine = Bottom line of the window border
  84.   ForeColor  = Foreground color of the window
  85.   BackColor  = Background color of the window
  86.   ForeBorder = Foreground color of the window border
  87.   BackBorder = Background color of the window border
  88.   Border     = Border type to use.  Where type is:
  89.                 0 - None used
  90.                 1 - '+'
  91.                 2 - '+'
  92.                 3 - '#'
  93.                 4 - '+'
  94.   ForeTitle  = Foreground color of the window title
  95.   BackTitle  = Background color of the window title
  96.  
  97.   If an error is encountered, the program will return the following
  98.   error codes in the ExecWin variable.
  99.  
  100.       97 - Title wider than the window
  101.       98 - The left or right screen margins have been exceeded
  102.       99 - The top or bottom screen margins have been exceeded
  103. }
  104.  
  105. LABEL
  106.    ExitExec;
  107.  
  108. VAR
  109.    A : WORD;
  110.  
  111. BEGIN
  112.    IF (LeftCol < 1) OR (RightCol > 80) THEN
  113.       BEGIN
  114.          ExecWin := 98;
  115.          GOTO ExitExec;
  116.       END;
  117.    IF (TopLine < 1) OR (BottomLine > 24) THEN
  118.       BEGIN
  119.          ExecWin := 99;
  120.          GOTO ExitExec;
  121.       END;
  122.    SaveScrn(0);
  123.    TextColor(ForeBorder);
  124.    TextBackground(BackBorder);
  125.    GotoXY(LeftCol, TopLine);
  126.    CASE Border OF
  127.       1 : BEGIN
  128.              Write('+');
  129.              FOR A := 1 TO (RightCol - LeftCol) - 1 DO
  130.                 Write('-');
  131.              Write('+');
  132.              FOR A := 1 TO (BottomLine - TopLine) - 1 DO
  133.                 BEGIN
  134.                    GotoXY(LeftCol, TopLine + A);
  135.                    Write('|');
  136.                    GotoXY(RightCol, TopLine + A);
  137.                    Write('|');
  138.                 END;
  139.              GotoXY(LeftCol, BottomLine);
  140.              Write('+');
  141.              FOR A := 1 TO (RightCol - LeftCol) - 1 DO
  142.                 Write('-');
  143.              Write('+');
  144.              IF Ord(Title[0]) > 0 THEN
  145.                 IF (Ord(Title[0])) <= (RightCol - LeftCol) THEN
  146.                    BEGIN
  147.                       A := Ord(Title[0]);
  148.                       A := RightCol - LeftCol - A;
  149.                       A := A DIV 2;
  150.                       GotoXY(A - 2 + LeftCol, TopLine);
  151.                       Write('+ ');
  152.                       TextColor(ForeTitle);
  153.                       TextBackground(BackTitle);
  154.                       Write(Title);
  155.                       TextColor(ForeBorder);
  156.                       TextBackground(BackBorder);
  157.                       Write(' +');
  158.                    END
  159.                 ELSE
  160.                    BEGIN
  161.                       ExecWin := 97;
  162.                       GOTO ExitExec;
  163.                    END;
  164.           END;
  165.       2 : BEGIN
  166.              Write('+');
  167.              FOR A := 1 TO (RightCol - LeftCol) - 1 DO
  168.                 Write('-');
  169.              Write('+');
  170.              FOR A := 1 TO (BottomLine - TopLine) - 1 DO
  171.                 BEGIN
  172.                    GotoXY(LeftCol, TopLine + A);
  173.                    Write('|');
  174.                    GotoXY(RightCol, TopLine + A);
  175.                    Write('|');
  176.                 END;
  177.              GotoXY(LeftCol, BottomLine);
  178.              Write('+');
  179.              FOR A := 1 TO (RightCol - LeftCol) - 1 DO
  180.                 Write('-');
  181.              Write('+');
  182.              IF Ord(Title[0]) > 0 THEN
  183.                 IF (Ord(Title[0])) <= (RightCol - LeftCol) THEN
  184.                    BEGIN
  185.                       A := Ord(Title[0]);
  186.                       A := RightCol - LeftCol - A;
  187.                       A := A DIV 2;
  188.                       GotoXY(A - 2 + LeftCol, TopLine);
  189.                       Write('+ ');
  190.                       TextColor(ForeTitle);
  191.                       TextBackground(BackTitle);
  192.                       Write(Title);
  193.                       TextColor(ForeBorder);
  194.                       TextBackground(BackBorder);
  195.                       Write(' +');
  196.                    END
  197.                 ELSE
  198.                    BEGIN
  199.                       ExecWin := 97;
  200.                       GOTO ExitExec;
  201.                    END;
  202.           END;
  203.       3 : BEGIN
  204.              Write('#');
  205.              FOR A := 1 TO (RightCol - LeftCol) - 1 DO
  206.                 Write('#');
  207.              Write('#');
  208.              FOR A := 1 TO (BottomLine - TopLine) - 1 DO
  209.                 BEGIN
  210.                    GotoXY(LeftCol, TopLine + A);
  211.                    Write('#');
  212.                    GotoXY(RightCol, TopLine + A);
  213.                    Write('#');
  214.                 END;
  215.              GotoXY(LeftCol, BottomLine);
  216.              Write('#');
  217.              FOR A := 1 TO (RightCol - LeftCol) - 1 DO
  218.                 Write('#');
  219.              Write('#');
  220.              IF Ord(Title[0]) > 0 THEN
  221.                 IF (Ord(Title[0])) <= (RightCol - LeftCol) THEN
  222.                    BEGIN
  223.                       A := Ord(Title[0]);
  224.                       A := RightCol - LeftCol - A;
  225.                       A := A DIV 2;
  226.                       GotoXY(A - 2 + LeftCol, TopLine);
  227.                       Write('# ');
  228.                       TextColor(ForeTitle);
  229.                       TextBackground(BackTitle);
  230.                       Write(Title);
  231.                       TextColor(ForeBorder);
  232.                       TextBackground(BackBorder);
  233.                       Write(' #');
  234.                    END
  235.                 ELSE
  236.                    BEGIN
  237.                       ExecWin := 97;
  238.                       GOTO ExitExec;
  239.                    END;
  240.           END;
  241.       4 : BEGIN
  242.              Write('+');
  243.              FOR A := 1 TO (RightCol - LeftCol) - 1 DO
  244.                 Write('-');
  245.              Write('+');
  246.              FOR A := 1 TO (BottomLine - TopLine) - 1 DO
  247.                 BEGIN
  248.                    GotoXY(LeftCol, TopLine + A);
  249.                    Write('|');
  250.                    GotoXY(RightCol, TopLine + A);
  251.                    Write('|');
  252.                 END;
  253.              GotoXY(LeftCol, BottomLine);
  254.              Write('+');
  255.              FOR A := 1 TO (RightCol - LeftCol) - 1 DO
  256.                 Write('-');
  257.              Write('+');
  258.              IF Ord(Title[0]) > 0 THEN
  259.                 IF (Ord(Title[0])) <= (RightCol - LeftCol) THEN
  260.                    BEGIN
  261.                       A := Ord(Title[0]);
  262.                       A := RightCol - LeftCol - A;
  263.                       A := A DIV 2;
  264.                       GotoXY(A - 2 + LeftCol, TopLine);
  265.                       Write('| ');
  266.                       TextColor(ForeTitle);
  267.                       TextBackground(BackTitle);
  268.                       Write(Title);
  269.                       TextColor(ForeBorder);
  270.                       TextBackground(BackBorder);
  271.                       Write(' |');
  272.                    END
  273.                 ELSE
  274.                    BEGIN
  275.                       ExecWin := 97;
  276.                       GOTO ExitExec;
  277.                    END;
  278.           END;
  279.       END;
  280.    TextColor(ForeColor);
  281.    TextBackground(BackColor);
  282.    Window(LeftCol + 1, TopLine + 1, RightCol - 1, BottomLine - 1);
  283.    ClrScr;
  284.    HookInt29;
  285.    SwapVectors;
  286.    Exec(ProgName, Params);
  287.    SwapVectors;
  288.    ExecWin := DOSExitCode;
  289.    SetIntVec($29,OldIntVect); { Restore the interrupt }
  290.    Window(1, 1, 80, 25);
  291.    RestoreScrn(0);
  292.  
  293.    ExitExec:
  294.  
  295. END;
  296.  
  297. END.
  298.  
  299. {
  300. The ScrnCopy unit may be found within the SWAG files or you can make up
  301. your own.
  302.  
  303. Tom Carroll
  304. Dataware Software
  305. }
  306.